home *** CD-ROM | disk | FTP | other *** search
/ Nautilus 1992 July / Nautilus-3-8 / Nautilus-3-8.bin / Tools & Utilities / Techy Stuff / Development Environments ƒ / Perl 4.0.2 ƒ / dolist.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-01-05  |  43.5 KB  |  1,920 lines
  1. /* $RCSfile: dolist.c,v $$Revision: 4.0.1.4 $$Date: 91/11/11 16:33:19 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    dolist.c,v $
  9.  * Revision 4.0.1.4  91/11/11  16:33:19  lwall
  10.  * patch19: added little-endian pack/unpack options
  11.  * patch19: sort $subname was busted by changes in 4.018
  12.  * 
  13.  * Revision 4.0.1.3  91/11/05  17:07:02  lwall
  14.  * patch11: prepared for ctype implementations that don't define isascii()
  15.  * patch11: /$foo/o optimizer could access deallocated data
  16.  * patch11: certain optimizations of //g in array context returned too many values
  17.  * patch11: regexp with no parens in array context returned wacky $`, $& and $'
  18.  * patch11: $' not set right on some //g
  19.  * patch11: added some support for 64-bit integers
  20.  * patch11: grep of a split lost its values
  21.  * patch11: added sort {} LIST
  22.  * patch11: multiple reallocations now avoided in 1 .. 100000
  23.  * 
  24.  * Revision 4.0.1.2  91/06/10  01:22:15  lwall
  25.  * patch10: //g only worked first time through
  26.  * 
  27.  * Revision 4.0.1.1  91/06/07  10:58:28  lwall
  28.  * patch4: new copyright notice
  29.  * patch4: added global modifier for pattern matches
  30.  * patch4: // wouldn't use previous pattern if it started with a null character
  31.  * patch4: //o and s///o now optimize themselves fully at runtime
  32.  * patch4: $` was busted inside s///
  33.  * patch4: caller($arg) didn't work except under debugger
  34.  * 
  35.  * Revision 4.0  91/03/20  01:08:03  lwall
  36.  * 4.0 baseline.
  37.  * 
  38.  */
  39.  
  40. #include "EXTERN.h"
  41. #include "perl.h"
  42.  
  43.  
  44. #ifdef BUGGY_MSC
  45.  #pragma function(memcmp)
  46. #endif /* BUGGY_MSC */
  47.  
  48. int
  49. do_match(str,arg,gimme,arglast)
  50. STR *str;
  51. register ARG *arg;
  52. int gimme;
  53. int *arglast;
  54. {
  55.     register STR **st = stack->ary_array;
  56.     register SPAT *spat = arg[2].arg_ptr.arg_spat;
  57.     register char *t;
  58.     register int sp = arglast[0] + 1;
  59.     STR *srchstr = st[sp];
  60.     register char *s = str_get(st[sp]);
  61.     char *strend = s + st[sp]->str_cur;
  62.     STR *tmpstr;
  63.     char *myhint = hint;
  64.     int global;
  65.     int safebase;
  66.  
  67.     hint = Nullch;
  68.     if (!spat) {
  69.     if (gimme == G_ARRAY)
  70.         return --sp;
  71.     str_set(str,Yes);
  72.     STABSET(str);
  73.     st[sp] = str;
  74.     return sp;
  75.     }
  76.     global = spat->spat_flags & SPAT_GLOBAL;
  77.     safebase = (gimme == G_ARRAY) || global;
  78.     if (!s)
  79.     fatal("panic: do_match");
  80.     if (spat->spat_flags & SPAT_USED) {
  81. #ifdef DEBUGGING
  82.     if (debug & 8)
  83.         deb("2.SPAT USED\n");
  84. #endif
  85.     if (gimme == G_ARRAY)
  86.         return --sp;
  87.     str_set(str,No);
  88.     STABSET(str);
  89.     st[sp] = str;
  90.     return sp;
  91.     }
  92.     --sp;
  93.     if (spat->spat_runtime) {
  94.     nointrp = "|)";
  95.     sp = eval(spat->spat_runtime,G_SCALAR,sp);
  96.     st = stack->ary_array;
  97.     t = str_get(tmpstr = st[sp--]);
  98.     nointrp = "";
  99. #ifdef DEBUGGING
  100.     if (debug & 8)
  101.         deb("2.SPAT /%s/\n",t);
  102. #endif
  103.     if (spat->spat_regexp) {
  104.         regfree(spat->spat_regexp);
  105.         spat->spat_regexp = Null(REGEXP*);    /* crucial if regcomp aborts */
  106.     }
  107.     spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
  108.         spat->spat_flags & SPAT_FOLD);
  109.     if (!spat->spat_regexp->prelen && lastspat)
  110.         spat = lastspat;
  111.     if (spat->spat_flags & SPAT_KEEP) {
  112.         scanconst(spat,spat->spat_regexp->precomp, spat->spat_regexp->prelen);
  113.         if (spat->spat_runtime)
  114.         arg_free(spat->spat_runtime);    /* it won't change, so */
  115.         spat->spat_runtime = Nullarg;    /* no point compiling again */
  116.         hoistmust(spat);
  117.         if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
  118.         curcmd->c_flags &= ~CF_OPTIMIZE;
  119.         opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
  120.         }
  121.     }
  122.     if (global) {
  123.         if (spat->spat_regexp->startp[0]) {
  124.         s = spat->spat_regexp->endp[0];
  125.         }
  126.     }
  127.     else if (!spat->spat_regexp->nparens)
  128.         gimme = G_SCALAR;            /* accidental array context? */
  129.     if (regexec(spat->spat_regexp, s, strend, s, 0,
  130.       srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
  131.       safebase)) {
  132.         if (spat->spat_regexp->subbase || global)
  133.         curspat = spat;
  134.         lastspat = spat;
  135.         goto gotcha;
  136.     }
  137.     else {
  138.         if (gimme == G_ARRAY)
  139.         return sp;
  140.         str_sset(str,&str_no);
  141.         STABSET(str);
  142.         st[++sp] = str;
  143.         return sp;
  144.     }
  145.     }
  146.     else {
  147. #ifdef DEBUGGING
  148.     if (debug & 8) {
  149.         char ch;
  150.  
  151.         if (spat->spat_flags & SPAT_ONCE)
  152.         ch = '?';
  153.         else
  154.         ch = '/';
  155.         deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
  156.     }
  157. #endif
  158.     if (!spat->spat_regexp->prelen && lastspat)
  159.         spat = lastspat;
  160.     t = s;
  161.     play_it_again:
  162.     if (global && spat->spat_regexp->startp[0])
  163.         t = s = spat->spat_regexp->endp[0];
  164.     if (myhint) {
  165.         if (myhint < s || myhint > strend)
  166.         fatal("panic: hint in do_match");
  167.         s = myhint;
  168.         if (spat->spat_regexp->regback >= 0) {
  169.         s -= spat->spat_regexp->regback;
  170.         if (s < t)
  171.             s = t;
  172.         }
  173.         else
  174.         s = t;
  175.     }
  176.     else if (spat->spat_short) {
  177.         if (spat->spat_flags & SPAT_SCANFIRST) {
  178.         if (srchstr->str_pok & SP_STUDIED) {
  179.             if (screamfirst[spat->spat_short->str_rare] < 0)
  180.             goto nope;
  181.             else if (!(s = screaminstr(srchstr,spat->spat_short)))
  182.             goto nope;
  183.             else if (spat->spat_flags & SPAT_ALL)
  184.             goto yup;
  185.         }
  186. #ifndef lint
  187.         else if (!(s = fbminstr((unsigned char*)s,
  188.           (unsigned char*)strend, spat->spat_short)))
  189.             goto nope;
  190. #endif
  191.         else if (spat->spat_flags & SPAT_ALL)
  192.             goto yup;
  193.         if (s && spat->spat_regexp->regback >= 0) {
  194.             ++spat->spat_short->str_u.str_useful;
  195.             s -= spat->spat_regexp->regback;
  196.             if (s < t)
  197.             s = t;
  198.         }
  199.         else
  200.             s = t;
  201.         }
  202.         else if (!multiline && (*spat->spat_short->str_ptr != *s ||
  203.           bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
  204.         goto nope;
  205.         if (--spat->spat_short->str_u.str_useful < 0) {
  206.         str_free(spat->spat_short);
  207.         spat->spat_short = Nullstr;    /* opt is being useless */
  208.         }
  209.     }
  210.     if (!spat->spat_regexp->nparens && !global) {
  211.         gimme = G_SCALAR;            /* accidental array context? */
  212.         safebase = FALSE;
  213.     }
  214.     if (regexec(spat->spat_regexp, s, strend, t, 0,
  215.       srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
  216.       safebase)) {
  217.         if (spat->spat_regexp->subbase || global)
  218.         curspat = spat;
  219.         lastspat = spat;
  220.         if (spat->spat_flags & SPAT_ONCE)
  221.         spat->spat_flags |= SPAT_USED;
  222.         goto gotcha;
  223.     }
  224.     else {
  225.         if (global)
  226.         spat->spat_regexp->startp[0] = Nullch;
  227.         if (gimme == G_ARRAY)
  228.         return sp;
  229.         str_sset(str,&str_no);
  230.         STABSET(str);
  231.         st[++sp] = str;
  232.         return sp;
  233.     }
  234.     }
  235.     /*NOTREACHED*/
  236.  
  237.   gotcha:
  238.     if (gimme == G_ARRAY) {
  239.     int iters, i, len;
  240.  
  241.     iters = spat->spat_regexp->nparens;
  242.     if (global && !iters)
  243.         i = 1;
  244.     else
  245.         i = 0;
  246.     if (sp + iters + i >= stack->ary_max) {
  247.         astore(stack,sp + iters + i, Nullstr);
  248.         st = stack->ary_array;        /* possibly realloced */
  249.     }
  250.  
  251.     for (i = !i; i <= iters; i++) {
  252.         st[++sp] = str_mortal(&str_no);
  253.         /*SUPPRESS 560*/
  254.         if (s = spat->spat_regexp->startp[i]) {
  255.         len = spat->spat_regexp->endp[i] - s;
  256.         if (len > 0)
  257.             str_nset(st[sp],s,len);
  258.         }
  259.     }
  260.     if (global)
  261.         goto play_it_again;
  262.     return sp;
  263.     }
  264.     else {
  265.     str_sset(str,&str_yes);
  266.     STABSET(str);
  267.     st[++sp] = str;
  268.     return sp;
  269.     }
  270.  
  271. yup:
  272.     ++spat->spat_short->str_u.str_useful;
  273.     lastspat = spat;
  274.     if (spat->spat_flags & SPAT_ONCE)
  275.     spat->spat_flags |= SPAT_USED;
  276.     if (global) {
  277.     spat->spat_regexp->subbeg = t;
  278.     spat->spat_regexp->subend = strend;
  279.     spat->spat_regexp->startp[0] = s;
  280.     spat->spat_regexp->endp[0] = s + spat->spat_short->str_cur;
  281.     curspat = spat;
  282.     goto gotcha;
  283.     }
  284.     if (sawampersand) {
  285.     char *tmps;
  286.  
  287.     if (spat->spat_regexp->subbase)
  288.         Safefree(spat->spat_regexp->subbase);
  289.     tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t);
  290.     spat->spat_regexp->subbeg = tmps;
  291.     spat->spat_regexp->subend = tmps + (strend-t);
  292.     tmps = spat->spat_regexp->startp[0] = tmps + (s - t);
  293.     spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur;
  294.     curspat = spat;
  295.     }
  296.     str_sset(str,&str_yes);
  297.     STABSET(str);
  298.     st[++sp] = str;
  299.     return sp;
  300.  
  301. nope:
  302.     spat->spat_regexp->startp[0] = Nullch;
  303.     ++spat->spat_short->str_u.str_useful;
  304.     if (global)
  305.     spat->spat_regexp->startp[0] = Nullch;
  306.     if (gimme == G_ARRAY)
  307.     return sp;
  308.     str_sset(str,&str_no);
  309.     STABSET(str);
  310.     st[++sp] = str;
  311.     return sp;
  312. }
  313.  
  314. #ifdef BUGGY_MSC
  315.  #pragma intrinsic(memcmp)
  316. #endif /* BUGGY_MSC */
  317.  
  318. int
  319. do_split(str,spat,limit,gimme,arglast)
  320. STR *str;
  321. register SPAT *spat;
  322. register int limit;
  323. int gimme;
  324. int *arglast;
  325. {
  326.     register ARRAY *ary = stack;
  327.     STR **st = ary->ary_array;
  328.     register int sp = arglast[0] + 1;
  329.     register char *s = str_get(st[sp]);
  330.     char *strend = s + st[sp--]->str_cur;
  331.     register STR *dstr;
  332.     register char *m;
  333.     int iters = 0;
  334.     int maxiters = (strend - s) + 10;
  335.     int i;
  336.     char *orig;
  337.     int origlimit = limit;
  338.     int realarray = 0;
  339.  
  340.     if (!spat || !s)
  341.     fatal("panic: do_split");
  342.     else if (spat->spat_runtime) {
  343.     nointrp = "|)";
  344.     sp = eval(spat->spat_runtime,G_SCALAR,sp);
  345.     st = stack->ary_array;
  346.     m = str_get(dstr = st[sp--]);
  347.     nointrp = "";
  348.     if (*m == ' ' && dstr->str_cur == 1) {
  349.         str_set(dstr,"\\s+");
  350.         m = dstr->str_ptr;
  351.         spat->spat_flags |= SPAT_SKIPWHITE;
  352.     }
  353.     if (spat->spat_regexp) {
  354.         regfree(spat->spat_regexp);
  355.         spat->spat_regexp = Null(REGEXP*);    /* avoid possible double free */
  356.     }
  357.     spat->spat_regexp = regcomp(m,m+dstr->str_cur,
  358.         spat->spat_flags & SPAT_FOLD);
  359.     if (spat->spat_flags & SPAT_KEEP ||
  360.         (spat->spat_runtime->arg_type == O_ITEM &&
  361.           (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) {
  362.         arg_free(spat->spat_runtime);    /* it won't change, so */
  363.         spat->spat_runtime = Nullarg;    /* no point compiling again */
  364.     }
  365.     }
  366. #ifdef DEBUGGING
  367.     if (debug & 8) {
  368.     deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
  369.     }
  370. #endif
  371.     ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
  372.     if (ary && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) {
  373.     realarray = 1;
  374.     if (!(ary->ary_flags & ARF_REAL)) {
  375.         ary->ary_flags |= ARF_REAL;
  376.         for (i = ary->ary_fill; i >= 0; i--)
  377.         ary->ary_array[i] = Nullstr;    /* don't free mere refs */
  378.     }
  379.     ary->ary_fill = -1;
  380.     sp = -1;    /* temporarily switch stacks */
  381.     }
  382.     else
  383.     ary = stack;
  384.     orig = s;
  385.     if (spat->spat_flags & SPAT_SKIPWHITE) {
  386.     while (isSPACE(*s))
  387.         s++;
  388.     }
  389.     if (!limit)
  390.     limit = maxiters + 2;
  391.     if (strEQ("\\s+",spat->spat_regexp->precomp)) {
  392.     while (--limit) {
  393.         /*SUPPRESS 530*/
  394.         for (m = s; m < strend && !isSPACE(*m); m++) ;
  395.         if (m >= strend)
  396.         break;
  397.         dstr = Str_new(30,m-s);
  398.         str_nset(dstr,s,m-s);
  399.         if (!realarray)
  400.         str_2mortal(dstr);
  401.         (void)astore(ary, ++sp, dstr);
  402.         /*SUPPRESS 530*/
  403.         for (s = m + 1; s < strend && isSPACE(*s); s++) ;
  404.     }
  405.     }
  406.     else if (strEQ("^",spat->spat_regexp->precomp)) {
  407.     while (--limit) {
  408.         /*SUPPRESS 530*/
  409.         for (m = s; m < strend && *m != '\n'; m++) ;
  410.         m++;
  411.         if (m >= strend)
  412.         break;
  413.         dstr = Str_new(30,m-s);
  414.         str_nset(dstr,s,m-s);
  415.         if (!realarray)
  416.         str_2mortal(dstr);
  417.         (void)astore(ary, ++sp, dstr);
  418.         s = m;
  419.     }
  420.     }
  421.     else if (spat->spat_short) {
  422.     i = spat->spat_short->str_cur;
  423.     if (i == 1) {
  424.         int fold = (spat->spat_flags & SPAT_FOLD);
  425.  
  426.         i = *spat->spat_short->str_ptr;
  427.         if (fold && isUPPER(i))
  428.         i = tolower(i);
  429.         while (--limit) {
  430.         if (fold) {
  431.             for ( m = s;
  432.               m < strend && *m != i &&
  433.                 (!isUPPER(*m) || tolower(*m) != i);
  434.               m++)            /*SUPPRESS 530*/
  435.             ;
  436.         }
  437.         else                /*SUPPRESS 530*/
  438.             for (m = s; m < strend && *m != i; m++) ;
  439.         if (m >= strend)
  440.             break;
  441.         dstr = Str_new(30,m-s);
  442.         str_nset(dstr,s,m-s);
  443.         if (!realarray)
  444.             str_2mortal(dstr);
  445.         (void)astore(ary, ++sp, dstr);
  446.         s = m + 1;
  447.         }
  448.     }
  449.     else {
  450. #ifndef lint
  451.         while (s < strend && --limit &&
  452.           (m=fbminstr((unsigned char*)s, (unsigned char*)strend,
  453.             spat->spat_short)) )
  454. #endif
  455.         {
  456.         dstr = Str_new(31,m-s);
  457.         str_nset(dstr,s,m-s);
  458.         if (!realarray)
  459.             str_2mortal(dstr);
  460.         (void)astore(ary, ++sp, dstr);
  461.         s = m + i;
  462.         }
  463.     }
  464.     }
  465.     else {
  466.     maxiters += (strend - s) * spat->spat_regexp->nparens;
  467.     while (s < strend && --limit &&
  468.         regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) {
  469.         if (spat->spat_regexp->subbase
  470.           && spat->spat_regexp->subbase != orig) {
  471.         m = s;
  472.         s = orig;
  473.         orig = spat->spat_regexp->subbase;
  474.         s = orig + (m - s);
  475.         strend = s + (strend - m);
  476.         }
  477.         m = spat->spat_regexp->startp[0];
  478.         dstr = Str_new(32,m-s);
  479.         str_nset(dstr,s,m-s);
  480.         if (!realarray)
  481.         str_2mortal(dstr);
  482.         (void)astore(ary, ++sp, dstr);
  483.         if (spat->spat_regexp->nparens) {
  484.         for (i = 1; i <= spat->spat_regexp->nparens; i++) {
  485.             s = spat->spat_regexp->startp[i];
  486.             m = spat->spat_regexp->endp[i];
  487.             dstr = Str_new(33,m-s);
  488.             str_nset(dstr,s,m-s);
  489.             if (!realarray)
  490.             str_2mortal(dstr);
  491.             (void)astore(ary, ++sp, dstr);
  492.         }
  493.         }
  494.         s = spat->spat_regexp->endp[0];
  495.     }
  496.     }
  497.     if (realarray)
  498.     iters = sp + 1;
  499.     else
  500.     iters = sp - arglast[0];
  501.     if (iters > maxiters)
  502.     fatal("Split loop");
  503.     if (s < strend || origlimit) {    /* keep field after final delim? */
  504.     dstr = Str_new(34,strend-s);
  505.     str_nset(dstr,s,strend-s);
  506.     if (!realarray)
  507.         str_2mortal(dstr);
  508.     (void)astore(ary, ++sp, dstr);
  509.     iters++;
  510.     }
  511.     else {
  512. #ifndef I286x
  513.     while (iters > 0 && ary->ary_array[sp]->str_cur == 0)
  514.         iters--,sp--;
  515. #else
  516.     char *zaps;
  517.     int   zapb;
  518.  
  519.     if (iters > 0) {
  520.         zaps = str_get(afetch(ary,sp,FALSE));
  521.         zapb = (int) *zaps;
  522.     }
  523.     
  524.     while (iters > 0 && (!zapb)) {
  525.         iters--,sp--;
  526.         if (iters > 0) {
  527.         zaps = str_get(afetch(ary,iters-1,FALSE));
  528.         zapb = (int) *zaps;
  529.         }
  530.     }
  531. #endif
  532.     }
  533.     if (realarray) {
  534.     ary->ary_fill = sp;
  535.     if (gimme == G_ARRAY) {
  536.         sp++;
  537.         astore(stack, arglast[0] + 1 + sp, Nullstr);
  538.         Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*);
  539.         return arglast[0] + sp;
  540.     }
  541.     }
  542.     else {
  543.     if (gimme == G_ARRAY)
  544.         return sp;
  545.     }
  546.     sp = arglast[0] + 1;
  547.     str_numset(str,(double)iters);
  548.     STABSET(str);
  549.     st[sp] = str;
  550.     return sp;
  551. }
  552.  
  553. int
  554. do_unpack(str,gimme,arglast)
  555. STR *str;
  556. int gimme;
  557. int *arglast;
  558. {
  559.     STR **st = stack->ary_array;
  560.     register int sp = arglast[0] + 1;
  561.     register char *pat = str_get(st[sp++]);
  562.     register char *s = str_get(st[sp]);
  563.     char *strend = s + st[sp--]->str_cur;
  564.     char *strbeg = s;
  565.     register char *patend = pat + st[sp]->str_cur;
  566.     int datumtype;
  567.     register int len;
  568.     register int bits;
  569.  
  570.     /* These must not be in registers: */
  571.     short ashort;
  572.     int aint;
  573.     long along;
  574. #ifdef QUAD
  575.     quad aquad;
  576. #endif
  577.     unsigned short aushort;
  578.     unsigned int auint;
  579.     unsigned long aulong;
  580. #ifdef QUAD
  581.     unsigned quad auquad;
  582. #endif
  583.     char *aptr;
  584.     float afloat;
  585.     double adouble;
  586.     int checksum = 0;
  587.     unsigned long culong;
  588.     double cdouble;
  589.  
  590.     if (gimme != G_ARRAY) {        /* arrange to do first one only */
  591.     /*SUPPRESS 530*/
  592.     for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
  593.     if (index("aAbBhH", *patend) || *pat == '%') {
  594.         patend++;
  595.         while (isDIGIT(*patend) || *patend == '*')
  596.         patend++;
  597.     }
  598.     else
  599.         patend++;
  600.     }
  601.     sp--;
  602.     while (pat < patend) {
  603.       reparse:
  604.     datumtype = *pat++;
  605.     if (pat >= patend)
  606.         len = 1;
  607.     else if (*pat == '*') {
  608.         len = strend - strbeg;    /* long enough */
  609.         pat++;
  610.     }
  611.     else if (isDIGIT(*pat)) {
  612.         len = *pat++ - '0';
  613.         while (isDIGIT(*pat))
  614.         len = (len * 10) + (*pat++ - '0');
  615.     }
  616.     else
  617.         len = (datumtype != '@');
  618.     switch(datumtype) {
  619.     default:
  620.         break;
  621.     case '%':
  622.         if (len == 1 && pat[-1] != '1')
  623.         len = 16;
  624.         checksum = len;
  625.         culong = 0;
  626.         cdouble = 0;
  627.         if (pat < patend)
  628.         goto reparse;
  629.         break;
  630.     case '@':
  631.         if (len > strend - s)
  632.         fatal("@ outside of string");
  633.         s = strbeg + len;
  634.         break;
  635.     case 'X':
  636.         if (len > s - strbeg)
  637.         fatal("X outside of string");
  638.         s -= len;
  639.         break;
  640.     case 'x':
  641.         if (len > strend - s)
  642.         fatal("x outside of string");
  643.         s += len;
  644.         break;
  645.     case 'A':
  646.     case 'a':
  647.         if (len > strend - s)
  648.         len = strend - s;
  649.         if (checksum)
  650.         goto uchar_checksum;
  651.         str = Str_new(35,len);
  652.         str_nset(str,s,len);
  653.         s += len;
  654.         if (datumtype == 'A') {
  655.         aptr = s;    /* borrow register */
  656.         s = str->str_ptr + len - 1;
  657.         while (s >= str->str_ptr && (!*s || isSPACE(*s)))
  658.             s--;
  659.         *++s = '\0';
  660.         str->str_cur = s - str->str_ptr;
  661.         s = aptr;    /* unborrow register */
  662.         }
  663.         (void)astore(stack, ++sp, str_2mortal(str));
  664.         break;
  665.     case 'B':
  666.     case 'b':
  667.         if (pat[-1] == '*' || len > (strend - s) * 8)
  668.         len = (strend - s) * 8;
  669.         str = Str_new(35, len + 1);
  670.         str->str_cur = len;
  671.         str->str_pok = 1;
  672.         aptr = pat;            /* borrow register */
  673.         pat = str->str_ptr;
  674.         if (datumtype == 'b') {
  675.         aint = len;
  676.         for (len = 0; len < aint; len++) {
  677.             if (len & 7)        /*SUPPRESS 595*/
  678.             bits >>= 1;
  679.             else
  680.             bits = *s++;
  681.             *pat++ = '0' + (bits & 1);
  682.         }
  683.         }
  684.         else {
  685.         aint = len;
  686.         for (len = 0; len < aint; len++) {
  687.             if (len & 7)
  688.             bits <<= 1;
  689.             else
  690.             bits = *s++;
  691.             *pat++ = '0' + ((bits & 128) != 0);
  692.         }
  693.         }
  694.         *pat = '\0';
  695.         pat = aptr;            /* unborrow register */
  696.         (void)astore(stack, ++sp, str_2mortal(str));
  697.         break;
  698.     case 'H':
  699.     case 'h':
  700.         if (pat[-1] == '*' || len > (strend - s) * 2)
  701.         len = (strend - s) * 2;
  702.         str = Str_new(35, len + 1);
  703.         str->str_cur = len;
  704.         str->str_pok = 1;
  705.         aptr = pat;            /* borrow register */
  706.         pat = str->str_ptr;
  707.         if (datumtype == 'h') {
  708.         aint = len;
  709.         for (len = 0; len < aint; len++) {
  710.             if (len & 1)
  711.             bits >>= 4;
  712.             else
  713.             bits = *s++;
  714.             *pat++ = hexdigit[bits & 15];
  715.         }
  716.         }
  717.         else {
  718.         aint = len;
  719.         for (len = 0; len < aint; len++) {
  720.             if (len & 1)
  721.             bits <<= 4;
  722.             else
  723.             bits = *s++;
  724.             *pat++ = hexdigit[(bits >> 4) & 15];
  725.         }
  726.         }
  727.         *pat = '\0';
  728.         pat = aptr;            /* unborrow register */
  729.         (void)astore(stack, ++sp, str_2mortal(str));
  730.         break;
  731.     case 'c':
  732.         if (len > strend - s)
  733.         len = strend - s;
  734.         if (checksum) {
  735.         while (len-- > 0) {
  736.             aint = *s++;
  737.             if (aint >= 128)    /* fake up signed chars */
  738.             aint -= 256;
  739.             culong += aint;
  740.         }
  741.         }
  742.         else {
  743.         while (len-- > 0) {
  744.             aint = *s++;
  745.             if (aint >= 128)    /* fake up signed chars */
  746.             aint -= 256;
  747.             str = Str_new(36,0);
  748.             str_numset(str,(double)aint);
  749.             (void)astore(stack, ++sp, str_2mortal(str));
  750.         }
  751.         }
  752.         break;
  753.     case 'C':
  754.         if (len > strend - s)
  755.         len = strend - s;
  756.         if (checksum) {
  757.           uchar_checksum:
  758.         while (len-- > 0) {
  759.             auint = *s++ & 255;
  760.             culong += auint;
  761.         }
  762.         }
  763.         else {
  764.         while (len-- > 0) {
  765.             auint = *s++ & 255;
  766.             str = Str_new(37,0);
  767.             str_numset(str,(double)auint);
  768.             (void)astore(stack, ++sp, str_2mortal(str));
  769.         }
  770.         }
  771.         break;
  772.     case 's':
  773.         along = (strend - s) / sizeof(short);
  774.         if (len > along)
  775.         len = along;
  776.         if (checksum) {
  777.         while (len-- > 0) {
  778.             bcopy(s,(char*)&ashort,sizeof(short));
  779.             s += sizeof(short);
  780.             culong += ashort;
  781.         }
  782.         }
  783.         else {
  784.         while (len-- > 0) {
  785.             bcopy(s,(char*)&ashort,sizeof(short));
  786.             s += sizeof(short);
  787.             str = Str_new(38,0);
  788.             str_numset(str,(double)ashort);
  789.             (void)astore(stack, ++sp, str_2mortal(str));
  790.         }
  791.         }
  792.         break;
  793.     case 'v':
  794.     case 'n':
  795.     case 'S':
  796.         along = (strend - s) / sizeof(unsigned short);
  797.         if (len > along)
  798.         len = along;
  799.         if (checksum) {
  800.         while (len-- > 0) {
  801.             bcopy(s,(char*)&aushort,sizeof(unsigned short));
  802.             s += sizeof(unsigned short);
  803. #ifdef HAS_NTOHS
  804.             if (datumtype == 'n')
  805.             aushort = ntohs(aushort);
  806. #endif
  807. #ifdef HAS_VTOHS
  808.             if (datumtype == 'v')
  809.             aushort = vtohs(aushort);
  810. #endif
  811.             culong += aushort;
  812.         }
  813.         }
  814.         else {
  815.         while (len-- > 0) {
  816.             bcopy(s,(char*)&aushort,sizeof(unsigned short));
  817.             s += sizeof(unsigned short);
  818.             str = Str_new(39,0);
  819. #ifdef HAS_NTOHS
  820.             if (datumtype == 'n')
  821.             aushort = ntohs(aushort);
  822. #endif
  823. #ifdef HAS_VTOHS
  824.             if (datumtype == 'v')
  825.             aushort = vtohs(aushort);
  826. #endif
  827.             str_numset(str,(double)aushort);
  828.             (void)astore(stack, ++sp, str_2mortal(str));
  829.         }
  830.         }
  831.         break;
  832.     case 'i':
  833.         along = (strend - s) / sizeof(int);
  834.         if (len > along)
  835.         len = along;
  836.         if (checksum) {
  837.         while (len-- > 0) {
  838.             bcopy(s,(char*)&aint,sizeof(int));
  839.             s += sizeof(int);
  840.             if (checksum > 32)
  841.             cdouble += (double)aint;
  842.             else
  843.             culong += aint;
  844.         }
  845.         }
  846.         else {
  847.         while (len-- > 0) {
  848.             bcopy(s,(char*)&aint,sizeof(int));
  849.             s += sizeof(int);
  850.             str = Str_new(40,0);
  851.             str_numset(str,(double)aint);
  852.             (void)astore(stack, ++sp, str_2mortal(str));
  853.         }
  854.         }
  855.         break;
  856.     case 'I':
  857.         along = (strend - s) / sizeof(unsigned int);
  858.         if (len > along)
  859.         len = along;
  860.         if (checksum) {
  861.         while (len-- > 0) {
  862.             bcopy(s,(char*)&auint,sizeof(unsigned int));
  863.             s += sizeof(unsigned int);
  864.             if (checksum > 32)
  865.             cdouble += (double)auint;
  866.             else
  867.             culong += auint;
  868.         }
  869.         }
  870.         else {
  871.         while (len-- > 0) {
  872.             bcopy(s,(char*)&auint,sizeof(unsigned int));
  873.             s += sizeof(unsigned int);
  874.             str = Str_new(41,0);
  875.             str_numset(str,(double)auint);
  876.             (void)astore(stack, ++sp, str_2mortal(str));
  877.         }
  878.         }
  879.         break;
  880.     case 'l':
  881.         along = (strend - s) / sizeof(long);
  882.         if (len > along)
  883.         len = along;
  884.         if (checksum) {
  885.         while (len-- > 0) {
  886.             bcopy(s,(char*)&along,sizeof(long));
  887.             s += sizeof(long);
  888.             if (checksum > 32)
  889.             cdouble += (double)along;
  890.             else
  891.             culong += along;
  892.         }
  893.         }
  894.         else {
  895.         while (len-- > 0) {
  896.             bcopy(s,(char*)&along,sizeof(long));
  897.             s += sizeof(long);
  898.             str = Str_new(42,0);
  899.             str_numset(str,(double)along);
  900.             (void)astore(stack, ++sp, str_2mortal(str));
  901.         }
  902.         }
  903.         break;
  904.     case 'V':
  905.     case 'N':
  906.     case 'L':
  907.         along = (strend - s) / sizeof(unsigned long);
  908.         if (len > along)
  909.         len = along;
  910.         if (checksum) {
  911.         while (len-- > 0) {
  912.             bcopy(s,(char*)&aulong,sizeof(unsigned long));
  913.             s += sizeof(unsigned long);
  914. #ifdef HAS_NTOHL
  915.             if (datumtype == 'N')
  916.             aulong = ntohl(aulong);
  917. #endif
  918. #ifdef HAS_VTOHL
  919.             if (datumtype == 'V')
  920.             aulong = vtohl(aulong);
  921. #endif
  922.             if (checksum > 32)
  923.             cdouble += (double)aulong;
  924.             else
  925.             culong += aulong;
  926.         }
  927.         }
  928.         else {
  929.         while (len-- > 0) {
  930.             bcopy(s,(char*)&aulong,sizeof(unsigned long));
  931.             s += sizeof(unsigned long);
  932.             str = Str_new(43,0);
  933. #ifdef HAS_NTOHL
  934.             if (datumtype == 'N')
  935.             aulong = ntohl(aulong);
  936. #endif
  937. #ifdef HAS_VTOHL
  938.             if (datumtype == 'V')
  939.             aulong = vtohl(aulong);
  940. #endif
  941.             str_numset(str,(double)aulong);
  942.             (void)astore(stack, ++sp, str_2mortal(str));
  943.         }
  944.         }
  945.         break;
  946.     case 'p':
  947.         along = (strend - s) / sizeof(char*);
  948.         if (len > along)
  949.         len = along;
  950.         while (len-- > 0) {
  951.         if (sizeof(char*) > strend - s)
  952.             break;
  953.         else {
  954.             bcopy(s,(char*)&aptr,sizeof(char*));
  955.             s += sizeof(char*);
  956.         }
  957.         str = Str_new(44,0);
  958.         if (aptr)
  959.             str_set(str,aptr);
  960.         (void)astore(stack, ++sp, str_2mortal(str));
  961.         }
  962.         break;
  963. #ifdef QUAD
  964.     case 'q':
  965.         while (len-- > 0) {
  966.         if (s + sizeof(quad) > strend)
  967.             aquad = 0;
  968.         else {
  969.             bcopy(s,(char*)&aquad,sizeof(quad));
  970.             s += sizeof(quad);
  971.         }
  972.         str = Str_new(42,0);
  973.         str_numset(str,(double)aquad);
  974.         (void)astore(stack, ++sp, str_2mortal(str));
  975.         }
  976.         break;
  977.     case 'Q':
  978.         while (len-- > 0) {
  979.         if (s + sizeof(unsigned quad) > strend)
  980.             auquad = 0;
  981.         else {
  982.             bcopy(s,(char*)&auquad,sizeof(unsigned quad));
  983.             s += sizeof(unsigned quad);
  984.         }
  985.         str = Str_new(43,0);
  986.         str_numset(str,(double)auquad);
  987.         (void)astore(stack, ++sp, str_2mortal(str));
  988.         }
  989.         break;
  990. #endif
  991.     /* float and double added gnb@melba.bby.oz.au 22/11/89 */
  992.     case 'f':
  993.     case 'F':
  994.         along = (strend - s) / sizeof(float);
  995.         if (len > along)
  996.         len = along;
  997.         if (checksum) {
  998.         while (len-- > 0) {
  999.             bcopy(s, (char *)&afloat, sizeof(float));
  1000.             s += sizeof(float);
  1001.             cdouble += afloat;
  1002.         }
  1003.         }
  1004.         else {
  1005.         while (len-- > 0) {
  1006.             bcopy(s, (char *)&afloat, sizeof(float));
  1007.             s += sizeof(float);
  1008.             str = Str_new(47, 0);
  1009.             str_numset(str, (double)afloat);
  1010.             (void)astore(stack, ++sp, str_2mortal(str));
  1011.         }
  1012.         }
  1013.         break;
  1014.     case 'd':
  1015.     case 'D':
  1016.         along = (strend - s) / sizeof(double);
  1017.         if (len > along)
  1018.         len = along;
  1019.         if (checksum) {
  1020.         while (len-- > 0) {
  1021.             bcopy(s, (char *)&adouble, sizeof(double));
  1022.             s += sizeof(double);
  1023.             cdouble += adouble;
  1024.         }
  1025.         }
  1026.         else {
  1027.         while (len-- > 0) {
  1028.             bcopy(s, (char *)&adouble, sizeof(double));
  1029.             s += sizeof(double);
  1030.             str = Str_new(48, 0);
  1031.             str_numset(str, (double)adouble);
  1032.             (void)astore(stack, ++sp, str_2mortal(str));
  1033.         }
  1034.         }
  1035.         break;
  1036.     case 'u':
  1037.         along = (strend - s) * 3 / 4;
  1038.         str = Str_new(42,along);
  1039.         while (s < strend && *s > ' ' && *s < 'a') {
  1040.         int a,b,c,d;
  1041.         char hunk[4];
  1042.  
  1043.         hunk[3] = '\0';
  1044.         len = (*s++ - ' ') & 077;
  1045.         while (len > 0) {
  1046.             if (s < strend && *s >= ' ')
  1047.             a = (*s++ - ' ') & 077;
  1048.             else
  1049.             a = 0;
  1050.             if (s < strend && *s >= ' ')
  1051.             b = (*s++ - ' ') & 077;
  1052.             else
  1053.             b = 0;
  1054.             if (s < strend && *s >= ' ')
  1055.             c = (*s++ - ' ') & 077;
  1056.             else
  1057.             c = 0;
  1058.             if (s < strend && *s >= ' ')
  1059.             d = (*s++ - ' ') & 077;
  1060.             else
  1061.             d = 0;
  1062.             hunk[0] = a << 2 | b >> 4;
  1063.             hunk[1] = b << 4 | c >> 2;
  1064.             hunk[2] = c << 6 | d;
  1065.             str_ncat(str,hunk, len > 3 ? 3 : len);
  1066.             len -= 3;
  1067.         }
  1068.         if (*s == '\n')
  1069.             s++;
  1070.         else if (s[1] == '\n')        /* possible checksum byte */
  1071.             s += 2;
  1072.         }
  1073.         (void)astore(stack, ++sp, str_2mortal(str));
  1074.         break;
  1075.     }
  1076.     if (checksum) {
  1077.         str = Str_new(42,0);
  1078.         if (index("fFdD", datumtype) ||
  1079.           (checksum > 32 && index("iIlLN", datumtype)) ) {
  1080. #ifdef macintosh
  1081.         extended modf();
  1082. #else
  1083.         double modf();
  1084. #endif
  1085.         double trouble;
  1086.  
  1087.         adouble = 1.0;
  1088.         while (checksum >= 16) {
  1089.             checksum -= 16;
  1090.             adouble *= 65536.0;
  1091.         }
  1092.         while (checksum >= 4) {
  1093.             checksum -= 4;
  1094.             adouble *= 16.0;
  1095.         }
  1096.         while (checksum--)
  1097.             adouble *= 2.0;
  1098.         along = (1 << checksum) - 1;
  1099.         while (cdouble < 0.0)
  1100.             cdouble += adouble;
  1101.         cdouble = modf(cdouble / adouble, &trouble) * adouble;
  1102.         str_numset(str,cdouble);
  1103.         }
  1104.         else {
  1105.         if (checksum < 32) {
  1106.             along = (1 << checksum) - 1;
  1107.             culong &= (unsigned long)along;
  1108.         }
  1109.         str_numset(str,(double)culong);
  1110.         }
  1111.         (void)astore(stack, ++sp, str_2mortal(str));
  1112.         checksum = 0;
  1113.     }
  1114.     }
  1115.     return sp;
  1116. }
  1117.  
  1118. int
  1119. do_slice(stab,str,numarray,lval,gimme,arglast)
  1120. STAB *stab;
  1121. STR *str;
  1122. int numarray;
  1123. int lval;
  1124. int gimme;
  1125. int *arglast;
  1126. {
  1127.     register STR **st = stack->ary_array;
  1128.     register int sp = arglast[1];
  1129.     register int max = arglast[2];
  1130.     register char *tmps;
  1131.     register int len;
  1132.     register int magic = 0;
  1133.     register ARRAY *ary;
  1134.     register HASH *hash;
  1135.     int oldarybase = arybase;
  1136.  
  1137.     if (numarray) {
  1138.     if (numarray == 2) {        /* a slice of a LIST */
  1139.         ary = stack;
  1140.         ary->ary_fill = arglast[3];
  1141.         arybase -= max + 1;
  1142.         st[sp] = str;        /* make stack size available */
  1143.         str_numset(str,(double)(sp - 1));
  1144.     }
  1145.     else
  1146.         ary = stab_array(stab);    /* a slice of an array */
  1147.     }
  1148.     else {
  1149.     if (lval) {
  1150.         if (stab == envstab)
  1151.         magic = 'E';
  1152.         else if (stab == sigstab)
  1153.         magic = 'S';
  1154. #ifdef SOME_DBM
  1155.         else if (stab_hash(stab)->tbl_dbm)
  1156.         magic = 'D';
  1157. #endif /* SOME_DBM */
  1158.     }
  1159.     hash = stab_hash(stab);        /* a slice of an associative array */
  1160.     }
  1161.  
  1162.     if (gimme == G_ARRAY) {
  1163.     if (numarray) {
  1164.         while (sp < max) {
  1165.         if (st[++sp]) {
  1166.             st[sp-1] = afetch(ary,
  1167.               ((int)str_gnum(st[sp])) - arybase, lval);
  1168.         }
  1169.         else
  1170.             st[sp-1] = &str_undef;
  1171.         }
  1172.     }
  1173.     else {
  1174.         while (sp < max) {
  1175.         if (st[++sp]) {
  1176.             tmps = str_get(st[sp]);
  1177.             len = st[sp]->str_cur;
  1178.             st[sp-1] = hfetch(hash,tmps,len, lval);
  1179.             if (magic)
  1180.             str_magic(st[sp-1],stab,magic,tmps,len);
  1181.         }
  1182.         else
  1183.             st[sp-1] = &str_undef;
  1184.         }
  1185.     }
  1186.     sp--;
  1187.     }
  1188.     else {
  1189.     if (numarray) {
  1190.         if (st[max])
  1191.         st[sp] = afetch(ary,
  1192.           ((int)str_gnum(st[max])) - arybase, lval);
  1193.         else
  1194.         st[sp] = &str_undef;
  1195.     }
  1196.     else {
  1197.         if (st[max]) {
  1198.         tmps = str_get(st[max]);
  1199.         len = st[max]->str_cur;
  1200.         st[sp] = hfetch(hash,tmps,len, lval);
  1201.         if (magic)
  1202.             str_magic(st[sp],stab,magic,tmps,len);
  1203.         }
  1204.         else
  1205.         st[sp] = &str_undef;
  1206.     }
  1207.     }
  1208.     arybase = oldarybase;
  1209.     return sp;
  1210. }
  1211.  
  1212. int
  1213. do_splice(ary,gimme,arglast)
  1214. register ARRAY *ary;
  1215. int gimme;
  1216. int *arglast;
  1217. {
  1218.     register STR **st = stack->ary_array;
  1219.     register int sp = arglast[1];
  1220.     int max = arglast[2] + 1;
  1221.     register STR **src;
  1222.     register STR **dst;
  1223.     register int i;
  1224.     register int offset;
  1225.     register int length;
  1226.     int newlen;
  1227.     int after;
  1228.     int diff;
  1229.     STR **tmparyval;
  1230.  
  1231.     if (++sp < max) {
  1232.     offset = ((int)str_gnum(st[sp])) - arybase;
  1233.     if (offset < 0)
  1234.         offset += ary->ary_fill + 1;
  1235.     if (++sp < max) {
  1236.         length = (int)str_gnum(st[sp++]);
  1237.         if (length < 0)
  1238.         length = 0;
  1239.     }
  1240.     else
  1241.         length = ary->ary_max + 1;        /* close enough to infinity */
  1242.     }
  1243.     else {
  1244.     offset = 0;
  1245.     length = ary->ary_max + 1;
  1246.     }
  1247.     if (offset < 0) {
  1248.     length += offset;
  1249.     offset = 0;
  1250.     if (length < 0)
  1251.         length = 0;
  1252.     }
  1253.     if (offset > ary->ary_fill + 1)
  1254.     offset = ary->ary_fill + 1;
  1255.     after = ary->ary_fill + 1 - (offset + length);
  1256.     if (after < 0) {                /* not that much array */
  1257.     length += after;            /* offset+length now in array */
  1258.     after = 0;
  1259.     if (!ary->ary_alloc) {
  1260.         afill(ary,0);
  1261.         afill(ary,-1);
  1262.     }
  1263.     }
  1264.  
  1265.     /* At this point, sp .. max-1 is our new LIST */
  1266.  
  1267.     newlen = max - sp;
  1268.     diff = newlen - length;
  1269.  
  1270.     if (diff < 0) {                /* shrinking the area */
  1271.     if (newlen) {
  1272.         New(451, tmparyval, newlen, STR*);    /* so remember insertion */
  1273.         Copy(st+sp, tmparyval, newlen, STR*);
  1274.     }
  1275.  
  1276.     sp = arglast[0] + 1;
  1277.     if (gimme == G_ARRAY) {            /* copy return vals to stack */
  1278.         if (sp + length >= stack->ary_max) {
  1279.         astore(stack,sp + length, Nullstr);
  1280.         st = stack->ary_array;
  1281.         }
  1282.         Copy(ary->ary_array+offset, st+sp, length, STR*);
  1283.         if (ary->ary_flags & ARF_REAL) {
  1284.         for (i = length, dst = st+sp; i; i--)
  1285.             str_2mortal(*dst++);    /* free them eventualy */
  1286.         }
  1287.         sp += length - 1;
  1288.     }
  1289.     else {
  1290.         st[sp] = ary->ary_array[offset+length-1];
  1291.         if (ary->ary_flags & ARF_REAL)
  1292.         str_2mortal(st[sp]);
  1293.     }
  1294.     ary->ary_fill += diff;
  1295.  
  1296.     /* pull up or down? */
  1297.  
  1298.     if (offset < after) {            /* easier to pull up */
  1299.         if (offset) {            /* esp. if nothing to pull */
  1300.         src = &ary->ary_array[offset-1];
  1301.         dst = src - diff;        /* diff is negative */
  1302.         for (i = offset; i > 0; i--)    /* can't trust Copy */
  1303.             *dst-- = *src--;
  1304.         }
  1305.         Zero(ary->ary_array, -diff, STR*);
  1306.         ary->ary_array -= diff;        /* diff is negative */
  1307.         ary->ary_max += diff;
  1308.     }
  1309.     else {
  1310.         if (after) {            /* anything to pull down? */
  1311.         src = ary->ary_array + offset + length;
  1312.         dst = src + diff;        /* diff is negative */
  1313.         Copy(src, dst, after, STR*);
  1314.         }
  1315.         Zero(&ary->ary_array[ary->ary_fill+1], -diff, STR*);
  1316.                         /* avoid later double free */
  1317.     }
  1318.     if (newlen) {
  1319.         for (src = tmparyval, dst = ary->ary_array + offset;
  1320.           newlen; newlen--) {
  1321.         *dst = Str_new(46,0);
  1322.         str_sset(*dst++,*src++);
  1323.         }
  1324.         Safefree(tmparyval);
  1325.     }
  1326.     }
  1327.     else {                    /* no, expanding (or same) */
  1328.     if (length) {
  1329.         New(452, tmparyval, length, STR*);    /* so remember deletion */
  1330.         Copy(ary->ary_array+offset, tmparyval, length, STR*);
  1331.     }
  1332.  
  1333.     if (diff > 0) {                /* expanding */
  1334.  
  1335.         /* push up or down? */
  1336.  
  1337.         if (offset < after && diff <= ary->ary_array - ary->ary_alloc) {
  1338.         if (offset) {
  1339.             src = ary->ary_array;
  1340.             dst = src - diff;
  1341.             Copy(src, dst, offset, STR*);
  1342.         }
  1343.         ary->ary_array -= diff;        /* diff is positive */
  1344.         ary->ary_max += diff;
  1345.         ary->ary_fill += diff;
  1346.         }
  1347.         else {
  1348.         if (ary->ary_fill + diff >= ary->ary_max)    /* oh, well */
  1349.             astore(ary, ary->ary_fill + diff, Nullstr);
  1350.         else
  1351.             ary->ary_fill += diff;
  1352.         if (after) {
  1353.             dst = ary->ary_array + ary->ary_fill;
  1354.             src = dst - diff;
  1355.             for (i = after; i; i--) {
  1356.             if (*dst)        /* str was hanging around */
  1357.                 str_free(*dst);    /*  after $#foo */
  1358.             *dst-- = *src;
  1359.             *src-- = Nullstr;
  1360.             }
  1361.         }
  1362.         }
  1363.     }
  1364.  
  1365.     for (src = st+sp, dst = ary->ary_array + offset; newlen; newlen--) {
  1366.         *dst = Str_new(46,0);
  1367.         str_sset(*dst++,*src++);
  1368.     }
  1369.     sp = arglast[0] + 1;
  1370.     if (gimme == G_ARRAY) {            /* copy return vals to stack */
  1371.         if (length) {
  1372.         Copy(tmparyval, st+sp, length, STR*);
  1373.         if (ary->ary_flags & ARF_REAL) {
  1374.             for (i = length, dst = st+sp; i; i--)
  1375.             str_2mortal(*dst++);    /* free them eventualy */
  1376.         }
  1377.         Safefree(tmparyval);
  1378.         }
  1379.         sp += length - 1;
  1380.     }
  1381.     else if (length) {
  1382.         st[sp] = tmparyval[length-1];
  1383.         if (ary->ary_flags & ARF_REAL)
  1384.         str_2mortal(st[sp]);
  1385.         Safefree(tmparyval);
  1386.     }
  1387.     else
  1388.         st[sp] = &str_undef;
  1389.     }
  1390.     return sp;
  1391. }
  1392.  
  1393. int
  1394. do_grep(arg,str,gimme,arglast)
  1395. register ARG *arg;
  1396. STR *str;
  1397. int gimme;
  1398. int *arglast;
  1399. {
  1400.     STR **st = stack->ary_array;
  1401.     register int dst = arglast[1];
  1402.     register int src = dst + 1;
  1403.     register int sp = arglast[2];
  1404.     register int i = sp - arglast[1];
  1405.     int oldsave = savestack->ary_fill;
  1406.     SPAT *oldspat = curspat;
  1407.     int oldtmps_base = tmps_base;
  1408.  
  1409.     savesptr(&stab_val(defstab));
  1410.     tmps_base = tmps_max;
  1411.     if ((arg[1].arg_type & A_MASK) != A_EXPR) {
  1412.     arg[1].arg_type &= A_MASK;
  1413.     dehoist(arg,1);
  1414.     arg[1].arg_type |= A_DONT;
  1415.     }
  1416.     arg = arg[1].arg_ptr.arg_arg;
  1417.     while (i-- > 0) {
  1418.     if (st[src]) {
  1419.         st[src]->str_pok &= ~SP_TEMP;
  1420.         stab_val(defstab) = st[src];
  1421.     }
  1422.     else
  1423.         stab_val(defstab) = str_mortal(&str_undef);
  1424.     (void)eval(arg,G_SCALAR,sp);
  1425.     st = stack->ary_array;
  1426.     if (str_true(st[sp+1]))
  1427.         st[dst++] = st[src];
  1428.     src++;
  1429.     curspat = oldspat;
  1430.     }
  1431.     restorelist(oldsave);
  1432.     tmps_base = oldtmps_base;
  1433.     if (gimme != G_ARRAY) {
  1434.     str_numset(str,(double)(dst - arglast[1]));
  1435.     STABSET(str);
  1436.     st[arglast[0]+1] = str;
  1437.     return arglast[0]+1;
  1438.     }
  1439.     return arglast[0] + (dst - arglast[1]);
  1440. }
  1441.  
  1442. int
  1443. do_reverse(arglast)
  1444. int *arglast;
  1445. {
  1446.     STR **st = stack->ary_array;
  1447.     register STR **up = &st[arglast[1]];
  1448.     register STR **down = &st[arglast[2]];
  1449.     register int i = arglast[2] - arglast[1];
  1450.  
  1451.     while (i-- > 0) {
  1452.     *up++ = *down;
  1453.     if (i-- > 0)
  1454.         *down-- = *up;
  1455.     }
  1456.     i = arglast[2] - arglast[1];
  1457.     Copy(down+1,up,i/2,STR*);
  1458.     return arglast[2] - 1;
  1459. }
  1460.  
  1461. int
  1462. do_sreverse(str,arglast)
  1463. STR *str;
  1464. int *arglast;
  1465. {
  1466.     STR **st = stack->ary_array;
  1467.     register char *up;
  1468.     register char *down;
  1469.     register int tmp;
  1470.  
  1471.     str_sset(str,st[arglast[2]]);
  1472.     up = str_get(str);
  1473.     if (str->str_cur > 1) {
  1474.     down = str->str_ptr + str->str_cur - 1;
  1475.     while (down > up) {
  1476.         tmp = *up;
  1477.         *up++ = *down;
  1478.         *down-- = tmp;
  1479.     }
  1480.     }
  1481.     STABSET(str);
  1482.     st[arglast[0]+1] = str;
  1483.     return arglast[0]+1;
  1484. }
  1485.  
  1486. static CMD *sortcmd;
  1487. static HASH *sortstash = Null(HASH*);
  1488. static STAB *firststab = Nullstab;
  1489. static STAB *secondstab = Nullstab;
  1490.  
  1491. int
  1492. do_sort(str,arg,gimme,arglast)
  1493. STR *str;
  1494. ARG *arg;
  1495. int gimme;
  1496. int *arglast;
  1497. {
  1498.     register STR **st = stack->ary_array;
  1499.     int sp = arglast[1];
  1500.     register STR **up;
  1501.     register int max = arglast[2] - sp;
  1502.     register int i;
  1503.     int sortcmp();
  1504.     int sortsub();
  1505.     STR *oldfirst;
  1506.     STR *oldsecond;
  1507.     ARRAY *oldstack;
  1508.     HASH *stash;
  1509.     STR *sortsubvar;
  1510.     static ARRAY *sortstack = Null(ARRAY*);
  1511.  
  1512.     if (gimme != G_ARRAY) {
  1513.     str_sset(str,&str_undef);
  1514.     STABSET(str);
  1515.     st[sp] = str;
  1516.     return sp;
  1517.     }
  1518.     up = &st[sp];
  1519.     sortsubvar = *up;
  1520.     st += sp;        /* temporarily make st point to args */
  1521.     for (i = 1; i <= max; i++) {
  1522.     /*SUPPRESS 560*/
  1523.     if (*up = st[i]) {
  1524.         if (!(*up)->str_pok)
  1525.         (void)str_2ptr(*up);
  1526.         else
  1527.         (*up)->str_pok &= ~SP_TEMP;
  1528.         up++;
  1529.     }
  1530.     }
  1531.     st -= sp;
  1532.     max = up - &st[sp];
  1533.     sp--;
  1534.     if (max > 1) {
  1535.     STAB *stab;
  1536.  
  1537.     if (arg[1].arg_type == (A_CMD|A_DONT)) {
  1538.         sortcmd = arg[1].arg_ptr.arg_cmd;
  1539.         stash = curcmd->c_stash;
  1540.     }
  1541.     else {
  1542.         if ((arg[1].arg_type & A_MASK) == A_WORD)
  1543.         stab = arg[1].arg_ptr.arg_stab;
  1544.         else
  1545.         stab = stabent(str_get(sortsubvar),TRUE);
  1546.  
  1547.         if (stab) {
  1548.         if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
  1549.             fatal("Undefined subroutine \"%s\" in sort", 
  1550.             stab_name(stab));
  1551.         stash = stab_stash(stab);
  1552.         }
  1553.         else
  1554.         sortcmd = Nullcmd;
  1555.     }
  1556.  
  1557.     if (sortcmd) {
  1558.         int oldtmps_base = tmps_base;
  1559.  
  1560.         if (!sortstack) {
  1561.         sortstack = anew(Nullstab);
  1562.         astore(sortstack, 0, Nullstr);
  1563.         aclear(sortstack);
  1564.         sortstack->ary_flags = 0;
  1565.         }
  1566.         oldstack = stack;
  1567.         stack = sortstack;
  1568.         tmps_base = tmps_max;
  1569.         if (sortstash != stash) {
  1570.         firststab = stabent("a",TRUE);
  1571.         secondstab = stabent("b",TRUE);
  1572.         sortstash = stash;
  1573.         }
  1574.         oldfirst = stab_val(firststab);
  1575.         oldsecond = stab_val(secondstab);
  1576. #ifndef lint
  1577.         qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub);
  1578. #else
  1579.         qsort(Nullch,max,sizeof(STR*),sortsub);
  1580. #endif
  1581.         stab_val(firststab) = oldfirst;
  1582.         stab_val(secondstab) = oldsecond;
  1583.         tmps_base = oldtmps_base;
  1584.         stack = oldstack;
  1585.     }
  1586. #ifndef lint
  1587.     else
  1588.         qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp);
  1589. #endif
  1590.     }
  1591.     return sp+max;
  1592. }
  1593.  
  1594. int
  1595. sortsub(str1,str2)
  1596. STR **str1;
  1597. STR **str2;
  1598. {
  1599.     stab_val(firststab) = *str1;
  1600.     stab_val(secondstab) = *str2;
  1601.     cmd_exec(sortcmd,G_SCALAR,-1);
  1602.     return (int)str_gnum(*stack->ary_array);
  1603. }
  1604.  
  1605. sortcmp(strp1,strp2)
  1606. STR **strp1;
  1607. STR **strp2;
  1608. {
  1609.     register STR *str1 = *strp1;
  1610.     register STR *str2 = *strp2;
  1611.     int retval;
  1612.  
  1613.     if (str1->str_cur < str2->str_cur) {
  1614.     /*SUPPRESS 560*/
  1615.     if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
  1616.         return retval;
  1617.     else
  1618.         return -1;
  1619.     }
  1620.     /*SUPPRESS 560*/
  1621.     else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
  1622.     return retval;
  1623.     else if (str1->str_cur == str2->str_cur)
  1624.     return 0;
  1625.     else
  1626.     return 1;
  1627. }
  1628.  
  1629. int
  1630. do_range(gimme,arglast)
  1631. int gimme;
  1632. int *arglast;
  1633. {
  1634.     STR **st = stack->ary_array;
  1635.     register int sp = arglast[0];
  1636.     register int i;
  1637.     register ARRAY *ary = stack;
  1638.     register STR *str;
  1639.     int max;
  1640.  
  1641.     if (gimme != G_ARRAY)
  1642.     fatal("panic: do_range");
  1643.  
  1644.     if (st[sp+1]->str_nok || !st[sp+1]->str_pok ||
  1645.       (looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) {
  1646.     i = (int)str_gnum(st[sp+1]);
  1647.     max = (int)str_gnum(st[sp+2]);
  1648.     if (max > i)
  1649.         (void)astore(ary, sp + max - i + 1, Nullstr);
  1650.     while (i <= max) {
  1651.         (void)astore(ary, ++sp, str = str_mortal(&str_no));
  1652.         str_numset(str,(double)i++);
  1653.     }
  1654.     }
  1655.     else {
  1656.     STR *final = str_mortal(st[sp+2]);
  1657.     char *tmps = str_get(final);
  1658.  
  1659.     str = str_mortal(st[sp+1]);
  1660.     while (!str->str_nok && str->str_cur <= final->str_cur &&
  1661.         strNE(str->str_ptr,tmps) ) {
  1662.         (void)astore(ary, ++sp, str);
  1663.         str = str_2mortal(str_smake(str));
  1664.         str_inc(str);
  1665.     }
  1666.     if (strEQ(str->str_ptr,tmps))
  1667.         (void)astore(ary, ++sp, str);
  1668.     }
  1669.     return sp;
  1670. }
  1671.  
  1672. int
  1673. do_repeatary(arglast)
  1674. int *arglast;
  1675. {
  1676.     STR **st = stack->ary_array;
  1677.     register int sp = arglast[0];
  1678.     register int items = arglast[1] - sp;
  1679.     register int count = (int) str_gnum(st[arglast[2]]);
  1680.     register int i;
  1681.     int max;
  1682.  
  1683.     max = items * count;
  1684.     if (max > 0 && sp + max > stack->ary_max) {
  1685.     astore(stack, sp + max, Nullstr);
  1686.     st = stack->ary_array;
  1687.     }
  1688.     if (count > 1) {
  1689.     for (i = arglast[1]; i > sp; i--)
  1690.         st[i]->str_pok &= ~SP_TEMP;
  1691.     repeatcpy((char*)&st[arglast[1]+1], (char*)&st[sp+1],
  1692.         items * sizeof(STR*), count);
  1693.     }
  1694.     sp += max;
  1695.  
  1696.     return sp;
  1697. }
  1698.  
  1699. int
  1700. do_caller(arg,maxarg,gimme,arglast)
  1701. ARG *arg;
  1702. int maxarg;
  1703. int gimme;
  1704. int *arglast;
  1705. {
  1706.     STR **st = stack->ary_array;
  1707.     register int sp = arglast[0];
  1708.     register CSV *csv = curcsv;
  1709.     STR *str;
  1710.     int count = 0;
  1711.  
  1712.     if (!csv)
  1713.     fatal("There is no caller");
  1714.     if (maxarg)
  1715.     count = (int) str_gnum(st[sp+1]);
  1716.     for (;;) {
  1717.     if (!csv)
  1718.         return sp;
  1719.     if (DBsub && csv->curcsv && csv->curcsv->sub == stab_sub(DBsub))
  1720.         count++;
  1721.     if (!count--)
  1722.         break;
  1723.     csv = csv->curcsv;
  1724.     }
  1725.     if (gimme != G_ARRAY) {
  1726.     STR *str = arg->arg_ptr.arg_str;
  1727.     str_set(str,csv->curcmd->c_stash->tbl_name);
  1728.     STABSET(str);
  1729.     st[++sp] = str;
  1730.     return sp;
  1731.     }
  1732.  
  1733. #ifndef lint
  1734.     (void)astore(stack,++sp,
  1735.       str_2mortal(str_make(csv->curcmd->c_stash->tbl_name,0)) );
  1736.     (void)astore(stack,++sp,
  1737.       str_2mortal(str_make(stab_val(csv->curcmd->c_filestab)->str_ptr,0)) );
  1738.     (void)astore(stack,++sp,
  1739.       str_2mortal(str_nmake((double)csv->curcmd->c_line)) );
  1740.     if (!maxarg)
  1741.     return sp;
  1742.     str = Str_new(49,0);
  1743.     stab_fullname(str, csv->stab);
  1744.     (void)astore(stack,++sp, str_2mortal(str));
  1745.     (void)astore(stack,++sp,
  1746.       str_2mortal(str_nmake((double)csv->hasargs)) );
  1747.     (void)astore(stack,++sp,
  1748.       str_2mortal(str_nmake((double)csv->wantarray)) );
  1749.     if (csv->hasargs) {
  1750.     ARRAY *ary = csv->argarray;
  1751.  
  1752.     if (!dbargs)
  1753.         dbargs = stab_xarray(aadd(stabent("DB'args", TRUE)));
  1754.     if (dbargs->ary_max < ary->ary_fill)
  1755.         astore(dbargs,ary->ary_fill,Nullstr);
  1756.     Copy(ary->ary_array, dbargs->ary_array, ary->ary_fill+1, STR*);
  1757.     dbargs->ary_fill = ary->ary_fill;
  1758.     }
  1759. #else
  1760.     (void)astore(stack,++sp,
  1761.       str_2mortal(str_make("",0)));
  1762. #endif
  1763.     return sp;
  1764. }
  1765.  
  1766. int
  1767. do_tms(str,gimme,arglast)
  1768. STR *str;
  1769. int gimme;
  1770. int *arglast;
  1771. {
  1772. #ifdef MSMAC
  1773.     return -1;
  1774. #else
  1775.     STR **st = stack->ary_array;
  1776.     register int sp = arglast[0];
  1777.  
  1778.     if (gimme != G_ARRAY) {
  1779.     str_sset(str,&str_undef);
  1780.     STABSET(str);
  1781.     st[++sp] = str;
  1782.     return sp;
  1783.     }
  1784.     (void)times(×buf);
  1785.  
  1786. #ifndef HZ
  1787. #define HZ 60
  1788. #endif
  1789.  
  1790. #ifndef lint
  1791.     (void)astore(stack,++sp,
  1792.       str_2mortal(str_nmake(((double)timesbuf.tms_utime)/HZ)));
  1793.     (void)astore(stack,++sp,
  1794.       str_2mortal(str_nmake(((double)timesbuf.tms_stime)/HZ)));
  1795.     (void)astore(stack,++sp,
  1796.       str_2mortal(str_nmake(((double)timesbuf.tms_cutime)/HZ)));
  1797.     (void)astore(stack,++sp,
  1798.       str_2mortal(str_nmake(((double)timesbuf.tms_cstime)/HZ)));
  1799. #else
  1800.     (void)astore(stack,++sp,
  1801.       str_2mortal(str_nmake(0.0)));
  1802. #endif
  1803.     return sp;
  1804. #endif
  1805. }
  1806.  
  1807. int
  1808. do_time(str,tmbuf,gimme,arglast)
  1809. STR *str;
  1810. struct tm *tmbuf;
  1811. int gimme;
  1812. int *arglast;
  1813. {
  1814.     register ARRAY *ary = stack;
  1815.     STR **st = ary->ary_array;
  1816.     register int sp = arglast[0];
  1817.  
  1818.     if (!tmbuf || gimme != G_ARRAY) {
  1819.     str_sset(str,&str_undef);
  1820.     STABSET(str);
  1821.     st[++sp] = str;
  1822.     return sp;
  1823.     }
  1824.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_sec)));
  1825.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_min)));
  1826.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_hour)));
  1827.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mday)));
  1828.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mon)));
  1829.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_year)));
  1830.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_wday)));
  1831.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_yday)));
  1832.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_isdst)));
  1833.     return sp;
  1834. }
  1835.  
  1836. int
  1837. do_kv(str,hash,kv,gimme,arglast)
  1838. STR *str;
  1839. HASH *hash;
  1840. int kv;
  1841. int gimme;
  1842. int *arglast;
  1843. {
  1844.     register ARRAY *ary = stack;
  1845.     STR **st = ary->ary_array;
  1846.     register int sp = arglast[0];
  1847.     int i;
  1848.     register HENT *entry;
  1849.     char *tmps;
  1850.     STR *tmpstr;
  1851.     int dokeys = (kv == O_KEYS || kv == O_HASH);
  1852.     int dovalues = (kv == O_VALUES || kv == O_HASH);
  1853.  
  1854.     if (gimme != G_ARRAY) {
  1855.     str_sset(str,&str_undef);
  1856.     STABSET(str);
  1857.     st[++sp] = str;
  1858.     return sp;
  1859.     }
  1860.     (void)hiterinit(hash);
  1861.     /*SUPPRESS 560*/
  1862.     while (entry = hiternext(hash)) {
  1863.     if (dokeys) {
  1864.         tmps = hiterkey(entry,&i);
  1865.         if (!i)
  1866.         tmps = "";
  1867.         (void)astore(ary,++sp,str_2mortal(str_make(tmps,i)));
  1868.     }
  1869.     if (dovalues) {
  1870.         tmpstr = Str_new(45,0);
  1871. #ifdef DEBUGGING
  1872.         if (debug & 8192) {
  1873.         sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
  1874.             hash->tbl_max+1,entry->hent_hash & hash->tbl_max);
  1875.         str_set(tmpstr,buf);
  1876.         }
  1877.         else
  1878. #endif
  1879.         str_sset(tmpstr,hiterval(hash,entry));
  1880.         (void)astore(ary,++sp,str_2mortal(tmpstr));
  1881.     }
  1882.     }
  1883.     return sp;
  1884. }
  1885.  
  1886. int
  1887. do_each(str,hash,gimme,arglast)
  1888. STR *str;
  1889. HASH *hash;
  1890. int gimme;
  1891. int *arglast;
  1892. {
  1893.     STR **st = stack->ary_array;
  1894.     register int sp = arglast[0];
  1895.     static STR *mystrk = Nullstr;
  1896.     HENT *entry = hiternext(hash);
  1897.     int i;
  1898.     char *tmps;
  1899.  
  1900.     if (mystrk) {
  1901.     str_free(mystrk);
  1902.     mystrk = Nullstr;
  1903.     }
  1904.  
  1905.     if (entry) {
  1906.     if (gimme == G_ARRAY) {
  1907.         tmps = hiterkey(entry, &i);
  1908.         if (!i)
  1909.         tmps = "";
  1910.         st[++sp] = mystrk = str_make(tmps,i);
  1911.     }
  1912.     st[++sp] = str;
  1913.     str_sset(str,hiterval(hash,entry));
  1914.     STABSET(str);
  1915.     return sp;
  1916.     }
  1917.     else
  1918.     return sp;
  1919. }
  1920.